home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
COMAL
/
A-COMAL Series
/
(k)aab.d64
/
proc.fft
< prev
next >
Wrap
Text File
|
2007-02-28
|
2KB
|
51 lines
0030 //
0040 ╨╥╧├ FFT(╥┼╞ REAL'DATA(),╥┼╞ IMAG'DATA(),LOG2'NUM'OF'DATA#) ├╠╧╙┼─
0050 // ╞OURIER TRANSFORM OF COMPLEX SERIES:
0060 // REAL'DATA(I)+J*IMAG'DATA(I) I=1....2^LOG2'NUM'OF'DATA#
0070 // FROM ┬RIGHAM, ┼.╧. 1974
0080 // ╘HE ╞AST ╞OURIER ╘RANSFORM
0090 // ╨RENTICE-╚ALL. P.164-165
0100 //
0110 TWO'PI:=2*╨╔
0120 NUM'OF'DATA#:=2^LOG2'NUM'OF'DATA#
0130 SEGMENT'SIZE#:=╔╬╘(NUM'OF'DATA#/2)
0140 LOG2'PART#:=LOG2'NUM'OF'DATA#-1
0150 K#:=0
0160 ╞╧╥ L#:=1 ╘╧ LOG2'NUM'OF'DATA# ─╧
0170 ╥┼╨┼┴╘
0180 ╞╧╥ I#:=1 ╘╧ SEGMENT'SIZE# ─╧
0190 P:=BIT'REVERSE#(╔╬╘(K#/SEGMENT'SIZE#),LOG2'NUM'OF'DATA#)
0200 ARG:=TWO'PI*P/NUM'OF'DATA#
0210 C:=├╧╙(ARG)
0220 S:=╙╔╬(ARG)
0230 K'PLUS'1#:=K#+1
0240 INDEX#:=K'PLUS'1#+SEGMENT'SIZE#
0250 REAL'TEMP:=REAL'DATA(INDEX#)*C+IMAG'DATA(INDEX#)*S
0260 IMAG'TEMP:=IMAG'DATA(INDEX#)*C-REAL'DATA(INDEX#)*S
0270 REAL'DATA(INDEX#):=REAL'DATA(K'PLUS'1#)-REAL'TEMP
0280 IMAG'DATA(INDEX#):=IMAG'DATA(K'PLUS'1#)-IMAG'TEMP
0290 REAL'DATA(K'PLUS'1#):=REAL'DATA(K'PLUS'1#)+REAL'TEMP
0300 IMAG'DATA(K'PLUS'1#):=IMAG'DATA(K'PLUS'1#)+IMAG'TEMP
0310 K#:=K#+1
0320 ┼╬─╞╧╥ I#
0330 K#:=K#+SEGMENT'SIZE#
0340 ╒╬╘╔╠ K#>=NUM'OF'DATA#
0350 K#:=0
0360 LOG2'PART#:=LOG2'PART#-1
0370 SEGMENT'SIZE#:=╔╬╘(SEGMENT'SIZE#/2)
0380 ┼╬─╞╧╥ L#
0390 // UNSCRAMBLE THE TRANSFORMED ARRAY:
0400 ╞╧╥ K#:=1 ╘╧ NUM'OF'DATA# ─╧
0410 K'MINUS'1#:=K#-1
0420 I#:=BIT'REVERSE#(K'MINUS'1#,LOG2'NUM'OF'DATA#)+1
0430 ╔╞ I#>K# ╘╚┼╬
0440 REAL'TEMP:=REAL'DATA(K#)
0450 IMAG'TEMP:=IMAG'DATA(K#)
0460 REAL'DATA(K#):=REAL'DATA(I#)
0470 IMAG'DATA(K#):=IMAG'DATA(I#)
0480 REAL'DATA(I#):=REAL'TEMP
0490 IMAG'DATA(I#):=IMAG'TEMP
0500 ┼╬─╔╞
0510 ┼╬─╞╧╥ K#
0520 ┼╬─╨╥╧├ FFT